home *** CD-ROM | disk | FTP | other *** search
/ ShareWare OnLine 2 / ShareWare OnLine Volume 2 (CMS Software)(1993).iso / prog / prot100.zip / CRCS.PAS next >
Pascal/Delphi Source File  |  1993-03-13  |  8KB  |  232 lines
  1. (*
  2.    CRC.PAS - Many routines to calculate CRCs.
  3.    Written: 05-31-90
  4.    Copyright (c)1990, Eric J. Givler, All Rights Reserved.
  5.  
  6. PROCEDURE blockCRC          - Calculate CRC-16 for variable block size.
  7. PROCEDURE ccitt_crc16_calc  - Calculate 16bit CRC on CCITT polynomial (asm)
  8. PROCEDURE ccitt_crc32_calc  - Calculate 32bit CRC on CCITT polynomial (asm)
  9. PROCEDURE calc_crc16        - Calculate CRC-16 for Xmodem BLOCK. (128)
  10. PROCEDURE calc_crc32        - Calculate CRC-32 for 512 byte block.
  11. PROCEDURE calcCRC           - Calculate 16bit CRC OR ChkSum on BYTE.
  12. PROCEDURE c_crc             - Calculate CRC-16 for variable block size.
  13. PROCEDURE updcrc            - Calculate CRC-16 based on TABLE.
  14. PROCEDURE updcrc2           - Calculate CRC-16 on a byte, updating crc.
  15. PROCEDURE crca              - Calculate CRC-16 via external ASM module
  16. PROCEDURE crcasm            - Calculate CRC-16 via external ASM module
  17. *)
  18. UNIT CRCS;
  19. interface
  20. type  ARRAY512 = RECORD
  21.                    len : integer;
  22.                    longstring : array[1..512] of char;
  23.                  END;
  24.       blocktype = array[0..127] of byte;
  25. var crc_input  : integer;
  26.     crc_reg_lo : integer;
  27.     crc_reg_hi : integer;
  28.     crc : integer;
  29.     chksum : byte;
  30.  
  31. procedure updcrc( var crc : word; c : integer);
  32. procedure ccitt_crc16_calc;
  33. procedure ccitt_crc32_calc;
  34. procedure calc_crc32(cs : ARRAY512);
  35. procedure calc_crc16(cs : blocktype);
  36. procedure calcCRC(data : byte);
  37. procedure blockCRC( segment,offset : word; count : integer);
  38. procedure c_crc(segment,offset:word; count:integer;var crc:integer);
  39. procedure crcasm(b : byte; VAR c : integer);
  40. procedure crca(VAR a {untyped}; l : word; VAR c : integer);
  41. procedure updcrc2(var crc : word; c : integer);
  42. implementation
  43.  
  44. CONST
  45.   Crctttab : array[0..255] of word =
  46. ($0000, $1021, $2042, $3063, $4084, $50A5, $60C6, $70E7,
  47.  $8108, $9129, $A14A, $B16B, $C18C, $D1AD, $E1CE, $F1EF,
  48.  $1231, $0210, $3273, $2252, $52B5, $4294, $72F7, $62D6,
  49.  $9339, $8318, $B37B, $A35A, $D3BD, $C39C, $F3FF, $E3DE,
  50.  $2462, $3443, $0420, $1401, $64E6, $74C7, $44A4, $5485,
  51.  $A56A, $B54B, $8528, $9509, $E5EE, $F5CF, $C5AC, $D58D,
  52.  $3653, $2672, $1611, $0630, $76D7, $66F6, $5695, $46B4,
  53.  $B75B, $A77A, $9719, $8738, $F7DF, $E7FE, $D79D, $C7BC,
  54.  $48C4, $58E5, $6886, $78A7, $0840, $1861, $2802, $3823,
  55.  $C9CC, $D9ED, $E98E, $F9AF, $8948, $9969, $A90A, $B92B,
  56.  $5AF5, $4AD4, $7AB7, $6A96, $1A71, $0A50, $3A33, $2A12,
  57.  $DBFD, $CBDC, $FBBF, $EB9E, $9B79, $8B58, $BB3B, $AB1A,
  58.  $6CA6, $7C87, $4CE4, $5CC5, $2C22, $3C03, $0C60, $1C41,
  59.  $EDAE, $FD8F, $CDEC, $DDCD, $AD2A, $BD0B, $8D68, $9D49,
  60.  $7E97, $6EB6, $5ED5, $4EF4, $3E13, $2E32, $1E51, $0E70,
  61.  $FF9F, $EFBE, $DFDD, $CFFC, $BF1B, $AF3A, $9F59, $8F78,
  62.  $9188, $81A9, $B1CA, $A1EB, $D10C, $C12D, $F14E, $E16F,
  63.  $1080, $00A1, $30C2, $20E3, $5004, $4025, $7046, $6067,
  64.  $83B9, $9398, $A3FB, $B3DA, $C33D, $D31C, $E37F, $F35E,
  65.  $02B1, $1290, $22F3, $32D2, $4235, $5214, $6277, $7256,
  66.  $B5EA, $A5CB, $95A8, $8589, $F56E, $E54F, $D52C, $C50D,
  67.  $34E2, $24C3, $14A0, $0481, $7466, $6447, $5424, $4405,
  68.  $A7DB, $B7FA, $8799, $97B8, $E75F, $F77E, $C71D, $D73C,
  69.  $26D3, $36F2, $0691, $16B0, $6657, $7676, $4615, $5634,
  70.  $D94C, $C96D, $F90E, $E92F, $99C8, $89E9, $B98A, $A9AB,
  71.  $5844, $4865, $7806, $6827, $18C0, $08E1, $3882, $28A3,
  72.  $CB7D, $DB5C, $EB3F, $FB1E, $8BF9, $9BD8, $ABBB, $BB9A,
  73.  $4A75, $5A54, $6A37, $7A16, $0AF1, $1AD0, $2AB3, $3A92,
  74.  $FD2E, $ED0F, $DD6C, $CD4D, $BDAA, $AD8B, $9DE8, $8DC9,
  75.  $7C26, $6C07, $5C64, $4C45, $3CA2, $2C83, $1CE0, $0CC1,
  76.  $EF1F, $FF3E, $CF5D, $DF7C, $AF9B, $BFBA, $8FD9, $9FF8,
  77.  $6E17, $7E36, $4E55, $5E74, $2E93, $3EB2, $0ED1, $1EF0
  78. );
  79.  
  80. {$l xcrc}
  81. procedure crcasm(b : byte; VAR c : integer); external;
  82. procedure crca(VAR a {untyped}; l : word; VAR c : integer); external;
  83.  
  84. procedure updcrc(var crc : word; c : integer);
  85. var tmp : integer;
  86. begin
  87.    tmp := (crc SHR 8) XOR c;
  88.    crc := (crc SHL 8) XOR crctttab[tmp];
  89. end;
  90.  
  91.  
  92. procedure ccitt_crc16_calc;       { CRC-16 }
  93. begin
  94.   inLine( $8B/$1E/crc_reg_hi );   {      mov   bx,crc_reg_hi    }
  95.   inLine( $B9/>$08 );             {      mov   cx, 8            }
  96.   inLine( $A1/crc_input );        {      mov   ax,crc_input     }
  97.   inLine( $D0/$D0 );              { u1:  rcl   al,1             }
  98.   inLine( $D1/$D3 );              {      rcl   bx,1             }
  99.   inLine( $73/$04 );              {      jnc   u2               }
  100.   inLine( $81/$F3/$1021 );        {      xor   bx, 1021h        }
  101.   inLine( $E2/$F4 );              { u2:  loop  u1               }
  102.   inLine( $89/$1E/crc_reg_hi);    {      mov   crc_reg_hi,bx    }
  103. end;
  104.  
  105.  
  106. procedure ccitt_crc32_calc;       { CRC-32 }
  107. begin
  108.   inLine( $8B/$1E/crc_reg_lo );   {      mov   bx,crc_reg_lo    }
  109.   inLine( $8B/$16/crc_reg_hi );   {      mov   dx,crc_reg_hi    }
  110.   inLine( $89/>$08 );             {      mov   cx,8             }
  111.   inLine( $A1/crc_input );        {      mov   ax,crc_input     }
  112.   inLine( $D0/$D8 );              { u1:  rcr   al,1             }
  113.   inLine( $D1/$DA );              {      rcr   dx,1             }
  114.   inLine( $D1/$DB );              {      rcr   bx,1             }
  115.   inLine( $73/$08 );              {      jnc   u2               }
  116.   inLine( $81/$F3/$8320 );        {      xor   bx,8320h         }
  117.   inLine( $81/$F2/$ED88 );        {      xor   dx,ED88h         }
  118.   inLine( $E2/$EE );              { u2:  loop  u1               }
  119.   inLine( $89/$1E/crc_reg_lo );   {      mov   crc_reg_lo, bx   }
  120.   inLine( $89/$16/crc_reg_hi );   {      mov   crc_reg_hi, dx   }
  121. end;
  122.  
  123.  
  124. procedure calc_crc32( cs : ARRAY512);
  125. var i : integer;
  126. begin
  127. { This routine calculates a 32 bit CRC based on the CCITT polynomial.
  128.   The result is stored in the CRC register, variables crc_reg_hi &
  129.   crc_reg_lo.                                                         }
  130.  
  131.   crc_reg_hi := 0;
  132.   crc_reg_lo := 0;
  133.   WITH cs DO BEGIN
  134.      FOR i := 1 TO Len DO BEGIN
  135.        crc_input := ORD(LongString[i]);
  136.        ccitt_crc32_calc;
  137.      END;
  138.   END;
  139.   crc_input := 0;
  140.   ccitt_crc32_calc;
  141.   ccitt_crc32_calc;
  142.   ccitt_crc32_calc;
  143.   ccitt_crc32_calc;
  144. end;
  145.  
  146.  
  147. procedure calc_crc16( cs : blocktype);
  148. var i : integer;
  149. begin
  150. { This routine calculates a 16 bit CRC based on the CCITT polynomial.
  151.   The result is stored in the CRC register, variable crc_reg_hi.      }
  152.  
  153.   crc_reg_hi := 0;
  154.   crc_reg_lo := 0;
  155.   for I := 0 to 127 do begin
  156.      crc_input := cs[i];
  157.      ccitt_crc16_calc;
  158.   end;
  159.   crc_input := 0;
  160.   ccitt_crc16_calc;
  161.   ccitt_crc16_calc;
  162. end;
  163.  
  164.  
  165. procedure calcCRC(data:byte);
  166. var carry : boolean;
  167.     i : byte;
  168. begin
  169.     chksum := Lo(chksum + data);
  170.     FOR i := 0 TO 7 do begin
  171.       carry := (crc and $8000) <> 0;
  172.       crc := crc SHL 1;
  173.       if (data and $80) <> 0 then crc := crc or $0001;
  174.       if carry then crc := crc xor $1021;
  175.       data := lo(data shl 1);
  176.     end;
  177. end;
  178.  
  179.  
  180. procedure updcrc2( var crc : word; c : integer);
  181. var i : integer;
  182. begin
  183.    crc := crc XOR c SHL 8;
  184.    for i := 0 to 7 do begin
  185.      if ((crc XOR c) AND $8000)<>0
  186.         then crc := (crc SHL 1) XOR $1021 else crc := crc SHL 1;
  187.    end;
  188.    crc := crc SHL 1;
  189. end;
  190.  
  191.  
  192. procedure blockCRC( segment,offset : word; count : integer);
  193. VAR i : integer;
  194. begin
  195.   crc_reg_hi := 0;
  196.   crc_reg_lo := 0;
  197.   for i := 0 TO count do begin
  198.      crc_input := Mem[segment:offset];
  199.      inc(offset);
  200.      ccitt_crc16_calc;
  201.   end;
  202.   crc_input := 0;
  203.   ccitt_crc16_calc;
  204.   ccitt_crc16_calc;
  205. end;
  206.  
  207. procedure c_crc(segment,offset:word; count:integer;var crc:integer);
  208. { usage:  c_crc( Seg(sector[0]), Ofs(sector[0]), 127, crc); }
  209. type BytePtr = ^Byte;
  210. VAR i,
  211.     j : integer;
  212.     b : BytePtr;
  213. begin
  214.    j := 0;
  215.    crc := 0;
  216.    b := New(BytePtr);
  217.    while (count >= 0) do begin
  218.       b := Ptr(segment,offset);
  219.       crc := crc xor b^ shl 8;
  220.       for i := 0 to 7 do begin
  221.     if (crc and $8000)<>0 then crc := crc SHL 1 xor $1021
  222.        else crc := crc SHL 1;
  223.       end;
  224.       inc(offset);
  225.       dec(count);
  226.    end;
  227.    b := Nil;
  228.    crc := crc AND $FFFF;
  229. end;
  230.  
  231. end.
  232.